home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / kingalbert.srx < prev    next >
Text File  |  2000-02-29  |  3KB  |  129 lines
  1. /***********************************\
  2. ** King Albert v1.0 for Solitarexx **
  3. **      by Michal Szafranski       **
  4. \***********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"King Albert v1.0"'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDTEXT 4 42 tex 6
  11. ADDSPACE 6 9
  12. ADDCYCLE 7 22 '"Any color|Alternative color|Same color"' 1 '"Cards go on"' 12
  13. ADDCYCLE 8 8 'No|Yes' 0 '"Use empty reserve"' 20
  14. ADDBUTTON 12 10 "Abort"
  15. ADDTEXT 14 42 tex 6
  16. SELECTGUI 3
  17.  
  18. SCREENSIZE 3 17 9 0
  19. DO i = 0 TO 8
  20.     NEWSTACK 3 8 0 i 0 0 0 17
  21.     stack.i = RESULT
  22. END
  23. DO i = 0 TO 3
  24.     NEWSTACK 2 8 i+2 i 2 0 17
  25.     base.i = RESULT
  26. END
  27. DO i = 0 TO 7
  28.     NEWSTACK (i>0) 8 (i=0) i//4+5 1+i%4 0 17
  29.     help.i = RESULT
  30. END
  31. deck = help.0
  32. ADDCARDS deck SHUFFLED
  33.  
  34. DO FOREVER
  35.     ACTION
  36.     PARSE VAR RESULT act rest
  37.     IF act = 1 THEN EXIT
  38.     IF act = 3 THEN CALL GAME
  39. END
  40.  
  41. GAME:
  42.     CLEANUP deck
  43.     SETGADGET 14 STR tex
  44.     SELECTGUI 4
  45.     sel = 0
  46.     fin = 0
  47.     GETGADGET 7
  48.     cmode = RESULT
  49.     GETGADGET 8
  50.     hmode = RESULT
  51.     DO i=0 TO 8
  52.         CARDSELECT deck 9-i
  53.         MOVECARDS deck stack.i REVERSE
  54.     END
  55.     DO i=1 TO 7
  56.         CARDSELECT deck 1
  57.         MOVECARDS deck help.i REVERSE
  58.     END
  59.     DO FOREVER
  60.         ACTION
  61.         PARSE VAR RESULT act stack sid card
  62.         SELECT
  63.         WHEN act = 1 THEN EXIT
  64.         WHEN act = 2 & sel = 0 & card>0 THEN sel = stack
  65.         WHEN act = 2 & sel > 0 THEN DO
  66.             SELECT
  67.                 WHEN sid = 2 | sel = stack THEN CALL DOBASE
  68.                 WHEN sid = 1 & hmode = 1 THEN CALL DOHELP
  69.                 WHEN sid = 3 THEN CALL DOSTACKS
  70.                 OTHERWISE ERRBEEP
  71.             END
  72.             sel = 0
  73.         END
  74.         WHEN act = 3 THEN DO
  75.             SELECTGUI 3
  76.             RETURN
  77.         END
  78.         OTHERWISE ERRBEEP
  79.         END
  80.     END
  81. RETURN
  82. DOHELP:
  83.     CARDSELECT stack 1
  84.     IF RESULT = '' THEN MOVECARDS sel stack
  85.     ELSE ERRBEEP
  86. RETURN
  87. DOSTACKS:
  88.     CARDSELECT sel 0 RELATIVE
  89.     PARSE VAR RESULT kolors wars xx
  90.     CARDSELECT stack 1
  91.     PARSE VAR RESULT kolor war xx
  92.     IF kolor = '' THEN DO
  93.         war = wars+1
  94.         kolor = kolors + (cmode = 1)
  95.     END
  96.     SELECT
  97.         WHEN cmode = 0 THEN kolor = 1
  98.         WHEN cmode = 1 THEN kolor = (kolor+kolors) // 2
  99.         WHEN cmode = 2 THEN kolor = kolor - kolors +1
  100.     END
  101.     IF war = wars+1 & kolor = 1 THEN MOVECARDS sel stack ATONCE
  102.     ELSE ERRBEEP
  103. RETURN
  104. DOBASE:
  105.     IF sel~=stack THEN CALL CHBASE
  106.     ELSE DO i= 0 TO 3 UNTIL ok=0
  107.         stack = base.i
  108.         CALL CHBASE
  109.     END
  110.     IF ok=0 THEN DO
  111.         fin = fin +1
  112.         MOVECARDS sel stack
  113.         IF fin = 52 THEN SETGADGET 14 STR wintex
  114.     END
  115.     ELSE ERRBEEP
  116. RETURN
  117. CHBASE:
  118.     CARDSELECT sel 1
  119.     PARSE VAR RESULT kolors wars xx
  120.     CARDSELECT stack 1
  121.     PARSE VAR RESULT kolor war xx
  122.     IF kolor = '' THEN DO
  123.         kolor = kolors
  124.         war = -1
  125.     END
  126.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  127.     ELSE ok = 1
  128. RETURN
  129.